home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / twars.arc / TEAM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  21KB  |  703 lines
  1.  
  2. overlay procedure team;
  3.  
  4. var
  5.  choices : str;
  6.  amount,
  7.  ij,ttn  : integer;
  8.  welldone: boolean;
  9.  
  10. procedure memberdisplay;
  11.  
  12. begin
  13.   cls;
  14.   ansic(5);
  15.   print('         Team Member Name     Sector  Fighters  Shields  Holds  Credits');
  16.   ansic(6);
  17.   print('-----------------------------------------------------------------------');
  18.   if userr.fr <> 0 then
  19.     for ij := 2 to 151 do
  20.       begin
  21.         readin(ij,userz);
  22.         if userz.fr = userr.fr then
  23.           begin
  24.             ansic(3);
  25.             print(addblank(userz.fa,25)+'  '+addblank(cstr(userz.ff),8)+addblank(cstr(userz.fg),10)
  26.                 +addblank(cstr(userz.fe),9)+addblank(cstr(userz.fh),7)+addblank(cstrr(userz.credits,10),10));
  27.           end;
  28.       end;
  29. end;
  30.  
  31. overlay procedure teamdisplay;
  32.  
  33. var
  34.    pertots : real;
  35.  
  36. begin
  37.   cls;
  38.   ansic(5);
  39.   print('Ranking Teams...');
  40.   for ij := 1 to 1000 do s[ij,1] := 0;
  41.   for ij := lp+1 to ls do
  42.     begin
  43.       readin(ij,userz);
  44.       if (userz.fl <> 0) and (userz.fm < 0) then
  45.       begin
  46.         s[(abs(userz.fm)-10),1] := s[(abs(userz.fm)-10),1] + userz.fl;
  47.         s[(abs(userz.fm)+40),1] := s[(abs(userz.fm)+40),1] + 1;
  48.         if (userz.fo > 0) then
  49.           s[(abs(userz.fm)+90),1] := s[(abs(userz.fm)+90),1] + 1;
  50.       end;
  51.     end;
  52.   cls;
  53.   ansic(3);
  54.   print('Team Number                 Team Name');
  55.   seek(teams,1);
  56.   for ij := 1 to 50 do
  57.   begin
  58.     read(teams,tteams);
  59.     if tteams.datemade <> '        ' then
  60.     begin
  61.        ansic(2);
  62.        print('-----------------------------------------------------');
  63.        ansic(6);
  64.        print(addblank(cstr(ij),5)+'       '+addblank(tteams.name,41));
  65.        ansic(5);
  66.        print('Creation Date: '+tteams.datemade+'     Team Combat Medals: '+cstr(tteams.kills));
  67.        pertots := 0;
  68.        for ttn := 2 to lp do
  69.        begin
  70.          readin(ttn,userz);
  71.          if userz.fr = ij then
  72.          begin
  73.            pertots := pertots + userz.fv;
  74.            if tteams.captain <> userz.fa then
  75.              begin
  76.                ansic(4);
  77.                print(addblank(userz.fa,53));
  78.              end
  79.            else
  80.              begin
  81.                ansic(7);
  82.                print('Team Captain ->'+addblank(userz.fa,38));
  83.              end;
  84.          end;
  85.        end;
  86.        tteams.rank := (pertots+(s[ij,1]*5.0)+(s[ij+50,1]*1000.0)+(s[ij+100,1]*10000.0)+(tteams.kills*750.0));
  87.        ansic(5);
  88.        print('Controlled Sectors: '+cstr(s[ij+50,1])+'       Controlled Planets: '+cstr(s[ij+100,1]));
  89.        ansic(4);
  90.        print('             Team value = '+cstrr( tteams.rank ,10) );
  91.     end;
  92.   end;
  93.   nl;
  94.   pausescr;
  95.   s[asd,1] := 0;
  96. end;
  97.  
  98. overlay procedure maketeam;
  99.  
  100. begin
  101. if userr.fr=0 then
  102. begin
  103.   cls;
  104.   ansic(7);
  105.   print('Creating New Team');
  106.   nl;
  107.   reset(teams);
  108.   ij := 0;
  109.   repeat
  110.     ij := ij + 1;
  111.     seek(teams,ij);
  112.     read(teams,tteams);
  113.   until hangup or (tteams.datemade='        ');
  114.   repeat
  115.     ansic(3);
  116.     prompt('Enter Team name ');
  117.     inputl(tteams.name,41);
  118.     ansic(3);
  119.     prompt(tteams.name+' is what you want? ');
  120.   until (yn) or hangup;
  121.   repeat
  122.     nl;
  123.     ansic(5);
  124.     prompt('Enter Team password ');
  125.     input(tteams.password,8);
  126.     ansic(5);
  127.     prompt(tteams.password+' is what you want? ');
  128.   until (yn) or hangup;
  129.   addmsg(userr.fa+' created a team under the name of '+tteams.name);
  130.   sysoplog(userr.fa+' created a team: '+tteams.name);
  131.   tteams.captain  := userr.fa;
  132.   tteams.datemade := date;
  133.   tteams.rank     := 0;
  134.   tteams.kills    := 0;
  135.   rteams := tteams;
  136.   seek(teams,ij);
  137.   write(teams,tteams);
  138.   userr.fr := ij;
  139.   writeout(pn,userr);
  140. end
  141. else
  142.   begin
  143.     ansic(8);
  144.     print('You may only be on one team at a time');
  145.   end;
  146. end;
  147.  
  148. overlay procedure password;
  149. begin
  150. if userr.fr = 0 then print('Sorry, you''re not on a team')
  151. else
  152.   begin
  153.   seek(teams,userr.fr);
  154.   read(teams,tteams);
  155.   if tteams.captain <> userr.fa then print('You''re not the Captain of your team!')
  156.   else
  157.     begin
  158.       cls;
  159.       print('The current password is '+tteams.password);
  160.       nl;
  161.       repeat
  162.         nl;
  163.         ansic(5);
  164.         prompt('Enter Team password ');
  165.         input(tteams.password,8);
  166.         ansic(5);
  167.         prompt(tteams.password+' is what you want? ');
  168.       until (yn) or hangup;
  169.       seek(teams,userr.fr);
  170.       write(teams,tteams);
  171.     end;
  172.   end;
  173. end;
  174.  
  175. overlay procedure jointeam;
  176.  
  177. begin
  178. if userr.fr = 0 then
  179.   begin
  180.     (* join a team *)
  181.     ttn := 0;
  182.     cls;
  183.     ansic(7);
  184.     prompt('Which team number do you wish to join? ');
  185.     input(choices,2);
  186.     if choices<>'' then ttn := value(choices);
  187.     if (ttn < 0) or (ttn > 50) then ttn := 0;
  188.     if ttn <> 0 then
  189.     begin
  190.       seek(teams,ttn);
  191.       read(teams,tteams);
  192.       nl;
  193.       if tteams.datemade <> '        ' then
  194.       begin
  195.         ansic(5);
  196.         prompt('Enter the Password to join - ');
  197.         input(choices,8);
  198.         if choices = tteams.password then
  199.           begin
  200.             userr.fr := ttn;
  201.             writeout(pn,userr);
  202.             ansic(6);
  203.             print(' Welcome aboard!  You''re in!');
  204.             rteams := tteams;
  205.             addmsg(userr.fa+' joined up with '+tteams.name);
  206.             sysoplog(userr.fa+' joined up with '+tteams.name);
  207.           end
  208.         else
  209.           begin
  210.             ansic(8);
  211.             print('Nice try, that has been recorded by Imperial Intelligence');
  212.             sysoplog(userr.fa+' tried to break into team: '+tteams.name);
  213.           end;
  214.         end
  215.       else
  216.         begin
  217.           ansic(3);
  218.           print('Sorry, that team is not active.  You need to make a new one.');
  219.         end;
  220.     end;
  221.   end
  222.  else
  223.   begin
  224.     ansic(8);
  225.     print('You are already on a team silly!');
  226.   end;
  227. end;
  228.  
  229. overlay procedure quitteam;
  230.  
  231. begin
  232. if userr.fr <> 0 then
  233. begin
  234.   cls;
  235.   ansic(7);
  236.   prompt('Are you sure you want to quit the team? ');
  237.   if yn then
  238.   begin
  239.     ansic(5);
  240.     print('Ok!  You''re off the team...');
  241.     seek(teams,userr.fr);
  242.     ttn := userr.fr;
  243.     read(teams,tteams);
  244.     if userr.fa <> tteams.captain then
  245.       begin
  246.         (* just drop this one member *)
  247.         userr.fr := 0;
  248.         writeout(pn,userr);
  249.         sysoplog(userr.fa+' quit team '+tteams.name);
  250.         addmsg(userr.fa+' deserted team '+tteams.name);
  251.         tteams.name := '';
  252.         tteams.captain := '';
  253.         tteams.datemade := '        ';
  254.         tteams.rank := 0;
  255.         tteams.kills := 0;
  256.         rteams := tteams;
  257.       end
  258.     else
  259.       begin
  260.       (* must remove team record and all members *)
  261.       for ij := 2 to 151 do
  262.         begin
  263.           readin(ij,userz);
  264.             if userz.fr = ttn then
  265.              begin
  266.                userz.fr := 0;
  267.                writeout(ij,userz);
  268.              end;
  269.            end;
  270.          for ij := lp+1 to ls do
  271.            begin
  272.              readin(ij,userz);
  273.              if (abs(userz.fm)-10 = ttn) and (userz.fm < 0) then
  274.              begin
  275.                userz.fl := 0;
  276.                userz.fm := 0;
  277.                writeout(ij,userz);
  278.              end;
  279.            end;
  280.            ansic(7);
  281.            prompt(tteams.name+' is now extinct!');
  282.            addmsg(userr.fa+' disbanded team '+tteams.name);
  283.            sysoplog(userr.fa+' disbanded team '+tteams.name);
  284.            userr.fr := 0;
  285.            writeout(pn,userr);
  286.            seek(teams,ttn);
  287.            read(teams,tteams);
  288.            tteams.name := '';
  289.            tteams.captain := '';
  290.            tteams.datemade := '        ';
  291.            tteams.rank := 0;
  292.            tteams.kills := 0;
  293.            rteams := tteams;
  294.            seek(teams,ttn);
  295.            write(teams,tteams);
  296.          end;
  297.      end;
  298.    end
  299.     else
  300.     begin
  301.       ansic(8);
  302.       print('You are not currently on a team!');
  303.      end;  (* end of quit team *)
  304. end;
  305.  
  306. overlay procedure creditxfer;
  307.  
  308. begin
  309. if userr.fo <> 0 then
  310.   begin   (* credit transfer *)
  311.     cls;
  312.     ttn := userr.fo;
  313.     welldone := FALSE;
  314.     repeat
  315.       readin(ttn,userz);
  316.       prompt('Exchange with '+userz.fa+' (Y/N) [N]? ');
  317.       if yn then
  318.         if ((userr.fr = userz.fr) and (userr.fr<>0)) then
  319.         begin
  320.           welldone := TRUE;
  321.           prompt('Transfer To or From '+userz.fa+' (T/F) [T]? ');
  322.           input(choices,1);
  323.           if choices = '' then choices := 'T';
  324.           print('You have '+cstrr(userr.credits,10)+' credits, and '+userz.fa+' has '+cstrr(userz.credits,10));
  325.           if choices = 'T' then ij := 1 else ij := (-1);
  326.           prompt('How much to transfer? ');
  327.           input(choices,4);
  328.           if choices = '' then amount :=0 else amount := (value(choices)*ij);
  329.           if ((userr.credits - amount) < 0) then
  330.             print('You don''t have the funds')
  331.           else
  332.             if ((userz.credits + amount) < 0) then
  333.               print(userz.fa+' doesn''t have that much')
  334.             else
  335.             begin
  336.               userr.credits := userr.credits - amount;
  337.               writeout(pn,userr);
  338.               userz.credits := userz.credits + amount;
  339.               writeout(ttn,userz);
  340.            print('You have '+cstrr(userr.credits,10)+' credits, and '+userz.fa+' has '+cstrr(userz.credits,10));
  341.             end;
  342.         end
  343.       else
  344.         begin
  345.         print('Hey!  What are you trying to pull?  They''re not on your team!');
  346.         if userr.fr = 0 then print('You''re not even ON a team!');
  347.         ttn := userz.fo;
  348.         end
  349.       else
  350.           ttn := userz.fo;
  351.     until welldone or (ttn=0) or hangup;
  352.   end
  353.  else
  354.   print('Your teammate must be in the same sector to conduct transfers!');
  355. end;
  356.  
  357.  
  358. overlay procedure fighterxfer;
  359.  
  360. begin
  361. if userr.fo <> 0 then
  362.   begin
  363.     cls;
  364.     ttn := userr.fo;
  365.     welldone := FALSE;
  366.     repeat
  367.       readin(ttn,userz);
  368.       prompt('Exchange with '+userz.fa+' (Y/N) [N]? ');
  369.       if yn then
  370.         if ((userr.fr = userz.fr) and (userr.fr<>0)) then
  371.         begin
  372.           welldone := TRUE;
  373.           prompt('Transfer To or From '+userz.fa+' (T/F) [T]? ');
  374.           input(choices,1);
  375.           if choices = '' then choices := 'T';
  376.           print('You have '+cstr(userr.fg)+' fighters, and '+userz.fa+' has '+cstr(userz.fg));
  377.           if choices = 'T' then ij := 1 else ij := (-1);
  378.           prompt('How many to transfer? ');
  379.           input(choices,4);
  380.           if choices = '' then amount :=0 else amount := (value(choices)*ij);
  381.           if ((userr.fg - amount) < 0) then
  382.             print('You don''t have the fighters')
  383.           else
  384.             if ((userz.fg + amount) < 0) then
  385.               print(userz.fa+' doesn''t have that many')
  386.             else
  387.             if ((userz.fg + amount) > 9999) or ((userr.fg - amount) > 9999) then
  388.               print('Maximum fleet size is 9999 fighters!')
  389.               else
  390.             begin
  391.               userr.fg := userr.fg - amount;
  392.               writeout(pn,userr);
  393.               userz.fg := userz.fg + amount;
  394.               writeout(ttn,userz);
  395.            print('You have '+cstr(userr.fg)+' fighters, and '+userz.fa+' has '+cstr(userz.fg));
  396.             end;
  397.         end
  398.       else
  399.         begin
  400.         print('Hey!  What are you trying to pull?  They''re not on your team!');
  401.         if userr.fr =0 then print('You''re not even ON a team!');
  402.         ttn := userz.fo;
  403.         end
  404.       else
  405.         ttn := userz.fo;
  406.     until welldone or (ttn=0) or hangup;
  407.   end
  408.  else
  409.   print('Your teammate must be in the same sector to conduct transfers!');
  410. end;
  411.  
  412. overlay procedure shieldxfer;
  413.  
  414. begin
  415. if userr.fo <> 0 then
  416.   begin
  417.     cls;
  418.     ttn := userr.fo;
  419.     welldone := FALSE;
  420.     repeat
  421.       readin(ttn,userz);
  422.       prompt('Exchange with '+userz.fa+' (Y/N) [N]? ');
  423.       if yn then
  424.         if ((userr.fr = userz.fr) and (userr.fr<>0)) then
  425.         begin
  426.           welldone := TRUE;
  427.           prompt('Transfer To or From '+userz.fa+' (T/F) [T]? ');
  428.           input(choices,1);
  429.           if choices = '' then choices := 'T';
  430.           print('You have '+cstr(userr.fe)+' shields, and '+userz.fa+' has '+cstr(userz.fe));
  431.           if choices = 'T' then ij := 1 else ij := (-1);
  432.           prompt('How many to transfer? ');
  433.           input(choices,4);
  434.           if choices = '' then amount :=0 else amount := (value(choices)*ij);
  435.           if ((userr.fe - amount) < 0) then
  436.             print('You don''t have the shields')
  437.           else
  438.             if ((userz.fe + amount) < 0) then
  439.               print(userz.fa+' doesn''t have that many')
  440.             else
  441.             if ((userz.fe + amount) > 200) or ((userr.fe - amount) > 200) then
  442.               print('Maximum shield array size is 200!')
  443.               else
  444.             begin
  445.               userr.fe := userr.fe - amount;
  446.               writeout(pn,userr);
  447.               userz.fe := userz.fe + amount;
  448.               writeout(ttn,userz);
  449.            print('You have '+cstr(userr.fe)+' shields, and '+userz.fa+' has '+cstr(userz.fe));
  450.             end;
  451.         end
  452.       else
  453.         begin
  454.         print('Hey!  What are you trying to pull?  They''re not on your team!');
  455.         if userr.fr =0 then print('You''re not even ON a team!');
  456.         ttn := userz.fo;
  457.         end
  458.       else
  459.         ttn := userz.fo;
  460.     until welldone or (ttn=0) or hangup;
  461.   end
  462.  else
  463.   print('Your teammate must be in the same sector to conduct transfers!');
  464. end;
  465.  
  466. overlay procedure holdxfer;
  467.  
  468. begin
  469. if userr.fo <> 0 then
  470.   begin
  471.     cls;
  472.     ttn := userr.fo;
  473.     welldone := FALSE;
  474.     repeat
  475.       readin(ttn,userz);
  476.       prompt('Exchange with '+userz.fa+' (Y/N) [N]? ');
  477.       if yn then
  478.         if ((userr.fr = userz.fr) and (userr.fr<>0)) then
  479.         begin
  480.           welldone := TRUE;
  481.           prompt('Transfer To or From '+userz.fa+' (T/F) [T]? ');
  482.           input(choices,1);
  483.           if choices = '' then choices := 'T';
  484.           print('You have '+cstr(userr.fh)+' holds, and '+userz.fa+' has '+cstr(userz.fh));
  485.           if choices = 'T' then ij := 1 else ij := (-1);
  486.           prompt('How many to transfer? ');
  487.           input(choices,4);
  488.           if choices = '' then amount :=0 else amount := (value(choices)*ij);
  489.           if ((userr.fh - amount) < 20) then
  490.             print('You don''t have the spare holds! (you must keep at least 20)')
  491.           else
  492.             if ((userz.fh + amount) < 20) then
  493.               print(userz.fa+' doesn''t have that many spare holds (must have 20)')
  494.             else
  495.             if ((userz.fh + amount) > 75) or ((userr.fh - amount) > 75) then
  496.               print('Maximum hold array size is 75!')
  497.               else
  498.               if ((((userz.fh-userz.fi-userz.fj-userz.fk) + amount) < 0) or
  499.                   (((userr.fh-userr.fi-userr.fj-userr.fk) - amount) < 0)) then
  500.                 print('Holds must be empty to allow transfer!')
  501.                 else
  502.                 begin
  503.                 userr.fh := userr.fh - amount;
  504.                 writeout(pn,userr);
  505.                 userz.fh := userz.fh + amount;
  506.                 writeout(ttn,userz);
  507.                 print('You have '+cstr(userr.fh)+' holds, and '+userz.fa+' has '+cstr(userz.fh));
  508.                 end;
  509.         end
  510.       else
  511.         begin
  512.         print('Hey!  What are you trying to pull?  They''re not on your team!');
  513.         if userr.fr =0 then print('You''re not even ON a team!');
  514.         ttn := userz.fo;
  515.         end
  516.       else
  517.         ttn := userz.fo;
  518.     until welldone or (ttn=0) or hangup;
  519.   end
  520.  else
  521.   print('Your teammate must be in the same sector to conduct transfers!');
  522. end;
  523.  
  524.  
  525. begin
  526.    nl;
  527.    ansic(6);
  528.    prompt('Team Menu');
  529.    readin(pn,userr);
  530.    while (choices <> 'X') do
  531.    begin
  532.      nl;
  533.      ansic(7);
  534.      prompt('Team Command (?=Menu) (X=Quit) [X] ');
  535.      input(choices,1);
  536.      if choices = '' then choices := 'X';
  537.      case choices of
  538.      'A' : memberdisplay;
  539.      'D' : teamdisplay;
  540.      'M' : maketeam;
  541.      'J' : jointeam;
  542.      'C' : creditxfer;
  543.      'P' : password;
  544.      'F' : fighterxfer;
  545.      'H' : holdxfer;
  546.      'S' : shieldxfer;
  547.      'T' : if userr.fr <> 0 then
  548.              begin   (* send team message *)
  549.              cls;
  550.              ansic(3);
  551.              print('Enter Message [160 chars]');
  552.              inputl(message1,160);
  553.              for ij := 2 to lp do
  554.                begin
  555.                  readin(ij,userz);
  556.                  if (userz.fr = userr.fr) AND (userz.fa <> userr.fa) then
  557.                    begin
  558.                      print('Transmitting to '+userz.fa);
  559.                      ssm(ij,' ');
  560.                      ssm(ij,'Team Message Received from '+userr.fa);
  561.                      ssm(ij,message1);
  562.                    end;
  563.                end;
  564.              end
  565.            else
  566.              print('You are not on a Team!');
  567.      'Q' : quitteam;
  568.      else
  569.         if choices <> 'X' then printfile('tradewar\teammenu.msg');
  570.      end;  (* end of case statement *)
  571.    end;
  572. end;
  573.  
  574. overlay procedure fighterscan;
  575.  
  576. var
  577.    l    : integer;
  578.    nope : boolean;
  579.    tots : integer;
  580.  
  581. begin
  582.    cls;
  583.    nl;
  584.    tots := 0;
  585.    nope := TRUE;
  586.    ansic(3);
  587.    print(' Deployed Fighters');
  588.    nl;
  589.    ansic(7);
  590.    print('Fighters     Sector   Personal/Team ');
  591.    ansic(5);
  592.    print('=====================================');
  593.    for l := lp+1 to ls do
  594.    begin
  595.       readin(l,usert);
  596.       if (usert.fm = pn) and (usert.fl <> 0) then
  597.       begin
  598.          ansic(4);
  599.          tots := tots + usert.fl;
  600.          print(addblank(cstr(usert.fl),7)+'    '+addblank(cstr(l-lp),8)+' Personal Fighters');
  601.          nope := FALSE;
  602.       end;
  603.       if ((abs(usert.fm)-10) = userr.fr) and (usert.fl <> 0) and (usert.fm < 0) then
  604.       begin
  605.          ansic(4);
  606.          tots := tots + usert.fl;
  607.          print(addblank(cstr(usert.fl),7)+'    '+addblank(cstr(l-lp),8)+'     Team Fighters');
  608.          nope := FALSE;
  609.       end;
  610.    end;
  611.    ansic(3);
  612.    if NOPE then print('No fighters deployed')
  613.       else print(addblank(cstr(tots),7)+' Total');
  614. end;
  615.  
  616. overlay procedure corbomite;
  617.  
  618. begin
  619.    cls;
  620.    nl;
  621.    ANSIC(8);
  622.    prompt('ARE YOU SURE CAPTAIN? (Y/N) [N] ');
  623.    if yn then
  624.      begin
  625.      addmsg(userr.fa+' self-destructed at '+time+' on '+date);
  626.      sysoplog(userr.fa+' self-destructed at '+time+' on '+date);
  627.      printfile('tradewar\destruct.msg');
  628.      destroyed;
  629.      end
  630.    else
  631.      begin
  632.        Ansic(8);
  633.        print('Self Destruct Aborted...');
  634.        nl;
  635.        nl;
  636.      end;
  637. end;
  638.  
  639.  
  640. overlay procedure fighters;
  641.  
  642.   var
  643.       D2,F2,N,L,B : INTEGER;
  644.       I           : STR;
  645.       choicy      : string[1];
  646. begin
  647.   ansic(8);
  648.   print('<Drop/Take Fighters>');
  649.   if prr< 2 then
  650.     begin
  651.       ansic(4);
  652.       printfile('tradewar\kentmad.msg');
  653.       userr.fh := trunc(userr.fh*0.9);
  654.       userr.fg := trunc(userr.fg*0.9);
  655.       writeout(pn,userr);
  656.     end
  657.   else
  658.     begin
  659.       readin(s2,usert);
  660.       d2 := usert.fl;
  661.       f2 := userr.fg;
  662.       ansic(2);
  663.       print('You have '+cstr(f2+d2)+' fighters available.');
  664.       prompt('How many fighters do you want defending this sector? ');
  665.       input(i,4);
  666.       n := value(i);
  667.       if N>=0 then
  668.         begin
  669.           L := N;
  670.           B := F2+D2-L;
  671.           if B<0 then
  672.             begin
  673.               ansic(8);
  674.               print('You don''t have that many ships available');
  675.             end
  676.           else
  677.             if B>9999 then
  678.               print('Too many ships in your fleet!  You are limited to 9999')
  679.             else
  680.               begin
  681.                 usert.fl := l;
  682.                 if (userr.fr = 0) or (l = 0) then usert.fm := pn
  683.                 else
  684.                 begin
  685.                   choicy := ' ';
  686.                   repeat
  687.                     ansic(5);
  688.                     prompt('Should these be Team fighters or Personal fighters? (T/P) ');
  689.                     input(choicy,1);
  690.                   until (choicy = 'T') or (choicy = 'P');
  691.                   if choicy = 'P' then usert.fm := pn
  692.                     else usert.fm := (-1*userr.fr-10);
  693.                 end;
  694.                 writeout(s2,usert);
  695.                 userr.fg := b;
  696.                 writeout(pn,userr);
  697.                 ansic(2);
  698.                 print('Done. You have '+cstr(b)+' fighter(s) in close support.');
  699.               end;
  700.         end;
  701.     end;
  702. end;
  703.